00100	BEGIN "MAIN"
00200	REQUIRE "HELIB[1,3]" LIBRARY;
00300	INTEGER ARRAY OBJECT[1:50,1:4];
00400	INTEGER ARRAY BUF[1:10000];
00500	INTEGER ARRAY STORAGE[1:25];
00600	INTEGER PICNUM,NPTS,COUNT,BRCHAR,EXT,PPN,B,X,EOF,FLAG,Y,Z,Z2;
00700	INTEGER DX,XINIT,XFINAL,TOTX,NX,YINIT,YFINAL,TOTY,NY,DY;
00800	INTEGER LAMBDA,GREY2,GREY,X2,Y2,NP,SUM,VAL,A,C,A0,A2,A4,ARG2,ARG4;
00900	STRING FILE;
01000	EXTERNAL INTEGER BITS,TVWORD,RSIDE,LSIDE,FLINE,LLINE,IWID;
01100	BOOLEAN FAIL;
01200	EXTERNAL PROCEDURE INTPNT;
01300	EXTERNAL PROCEDURE ADJUST;
01400	EXTERNAL PROCEDURE PUTPNT (INTEGER X,Y,VAL);
01500	EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;
01600	     REFERENCE BOOLEAN FAIL; INTEGER ARRAY STORAGE);
01700	EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY BUF);
01800	INTEGER PROCEDURE GETPAR;
01900	  BEGIN
02000	
02100	OPEN(2,"DSK",0,3,0,COUNT,BRCHAR,EOF);
02200	LOOKUP(2,"OBJ.1[2,DBL]",FLAG);
02300	OUTSTR("TYPE IN NPTS...");
02400	NPTS←CVD(INCHWL);
02500	FOR X←1 STEP 1 UNTIL NPTS DO
02600	  FOR Y←1 STEP 1 UNTIL 4 DO
02700	    OBJECT[X,Y] ← INTIN(2);
02800	CLOSE(2);
02900	FOR X←NPTS+1 STEP 1 UNTIL 50 DO
03000	  FOR Y←1 STEP 1 UNTIL 4 DO
03100	    OBJECT[X,Y]←0;
03200	OUTSTR("TYPE XINIT... ");
03300	XINIT←CVD(INCHWL);
03400	OUTSTR("TYPE XFINAL.. ");
03500	XFINAL←CVD(INCHWL);
03600	OUTSTR("TYPE DELTA-X.. ");
03700	DX←CVD(INCHWL);
03800	TOTX←XFINAL-XINIT;
03900	NX←(TOTX+DX-1)/DX;
04000	OUTSTR("THEN TOTAL-X IS "&CVS(TOTX)&"  AND NX (THE LINE LENGTH) IS "
04100	          &CVS(NX)&'15 & '12);
04200	OUTSTR("TYPE YINIT... ");
04300	YINIT←CVD(INCHWL);
04400	OUTSTR("TYPE YFINAL.. ");
04500	YFINAL←CVD(INCHWL);
04600	OUTSTR("TYPE DELTA-Y... ");
04700	DY←CVD(INCHWL);
04800	TOTY←YFINAL-YINIT;
04900	NY←(TOTY+DY-1)/DY;
05000	OUTSTR("THEN TOTAL-Y IS " & CVS(TOTY) &
05100	   "   AND NY (THE VERT. HEIGHT) IS " & CVS(NY) & '15 & '12);
05200	OUTSTR("TYPE LAMBDA (ACTUALLY, LAMBDA SQUARED /16 PI-SQUARED)... ");
05300	LAMBDA ← CVD(INCHWL);
05400	OUTSTR("TYPE THE LOG (BASE 2) OF THE GREY SCALE... ");
05500	BITS ← CVD(INCHWL);
05600	GREY ← 2↑BITS;
05700	GREY2 ← GREY / 2;
05800	A0 ←100;
05900	A2 ←-50;
06000	A4 ←4;
06100	OUTSTR("THUS OUR GREY SCALE RANGES FROM 1 TO "&CVS(GREY)
06200	  & '15 & '12);
06300	END;
06400	
06500	INTEGER PROCEDURE INIT; BEGIN
06600	  GETPAR;
06700	  TVWORD ← GIOWD(BUF);
06800	  RSIDE ←  NX-1;
06900	  LSIDE ← 0;
07000	  FLINE ← 0;
07100	  LLINE ←  NY-1;
07200	  IWID ← RSIDE - LSIDE + 1;
07300	
07400	
07500	FOR X ← 2 STEP 1 UNTIL 25 DO STORAGE[X]←0;
07600	STORAGE[1]←TVWORD+1;
07700	
07800	  ADJUST;
07900	  INTPNT;
08000	
08100	OUTSTR("TYPE IN THE PICTURE NUMBER....");
08200	PICNUM←CVD(INCHWL);
08300	FILE ← "H."&CVS(PICNUM)&"[2,DBL]";
08400	  END;
08500	
08600	INTEGER PROCEDURE COS2(INTEGER A,B,C);
08700	  BEGIN
08800	  ARG2 ← ((A*A) + (B*B) + (C*C)) / LAMBDA;
08900	  ARG4 ← ARG2 * ARG2;
09000	  VAL ← A0  + (A2*ARG2)  +  (A*ARG4);
09100	  RETURN(VAL);
09200	  END;
09300	
09400	
09500	INTEGER PROCEDURE GETVAL(INTEGER X,Y);
09600	  BEGIN
09700	  SUM ← 0;
09800	  X2 ← XINIT + (DX*X);
09900	  Y2 ← YINIT + (DY*Y);
10000	  FOR NP← 1 STEP 1 UNTIL NPTS DO
10100	   SUM ← SUM + (OBJECT[NP,4]*COS2((X2-OBJECT[NP,1]),
10200	         (Y2-OBJECT[NP,2]),  OBJECT[NP,3]));
10300	  SUM ← (SUM MOD GREY2) + GREY2;
10400	  RETURN(SUM);
10500	  END;
10600	
10700	
10800	INIT;
10900	B←5;
11000	FOR X← LSIDE STEP 1 UNTIL RSIDE DO
11100	BEGIN
11200	  OUTSTR(CVS(X)&" "&CVS(B)&" ");
11300	  FOR Y ← FLINE STEP 1 UNTIL LLINE DO
11400	    BEGIN
11500	      B←GETVAL(X,Y);
11600	      PUTPNT(X,Y,B);
11700	    END;
11800	END;
11900	
12000	PICWR(1,CVFIL(FILE,EXT,PPN),EXT, PPN  ,FAIL,STORAGE);
12100	OUTSTR("BUF HAS BEEN TRANSFERRED TO FILE " & FILE);
12200	OUTSTR(CVS(FAIL)) 
12300	END ;
12400